home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / adaed-1.11 / adaed-1 / Adaed-1.11.0a / expand.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-07  |  49.0 KB  |  1,819 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. #define GEN
  10.  
  11. #include "hdr.h"
  12. #include "libhdr.h"
  13. #include "vars.h"
  14. #include "gvars.h"
  15. #include "attr.h"
  16. #include "slot.h"
  17. #include "segment.h"
  18. #include "setprots.h"
  19. #include "langprots.h"
  20. #include "initprots.h"
  21. #include "initobjprots.h"
  22. #include "dbxprots.h"
  23. #include "miscprots.h"
  24. #include "utilprots.h"
  25. #include "glibprots.h"
  26. #include "readprots.h"
  27. #include "libprots.h"
  28. #include "arithprots.h"
  29. #include "librprots.h"
  30. #include "gnodesprots.h"
  31. #include "gmiscprots.h"
  32. #include "gutilprots.h"
  33. #include "aggrprots.h"
  34. #include "chapprots.h"
  35. #include "smiscprots.h"
  36. #include "gmainprots.h"
  37. #include "expandprots.h"
  38.  
  39. void expand(Node node)                                                /*;expand*/
  40. {
  41.     /*
  42.      * Expander
  43.      * Performs a set of semantic transformations on the tree
  44.      * in order to simplify the job for the code generator.
  45.      * Some semantic optimizations are performed too.
  46.      * IMPORTANT: 
  47.      *    expand must not be called twice on the same structure, as
  48.      *    for some kinds of nodes, the format before expand is
  49.      *    different from the format after expand. A special problem
  50.      *    arises for aggregates, where already expanded structures
  51.      *    (subaggregates) are part of a not yet expanded structure
  52.      *    (assignment to enclosing structure) that must be expanded.
  53.      *    a special node, as_expanded, is used to block double
  54.      *    expansion in that case.
  55.      */
  56.  
  57.     Fortup      ft1, ft2;
  58.     Tuple       tup, tup1, tup2;
  59.     Symbolmap   instance_map, type_map;
  60.     Node        node1, node2, node3, node4;
  61.     Symbol      sym1, sym2, sym3, sym4;
  62.     int         nk, cboolean;
  63.     Const       lv;
  64.     Unitdecl    ud;
  65.  
  66.     /* TBSL remove the following declarations */
  67.     Const       lbd_1, ubd_1, lbd_2, ubd_2;
  68.     int         ubd_1_val, ubd_2_val, lbd_1_val, lbd_2_val;
  69.  
  70.     Tuple  instantiation_code, ntup ;
  71. #ifdef TRACE
  72.     if (debug_flag)
  73.         gen_trace_node("EXPAND", node);
  74. #endif
  75.  
  76. #ifdef DEBUG
  77.     if (trapns>0 && N_SEQ(node)== trapns && N_UNIT(node) == trapnu) trapn(node);
  78. #endif
  79.     switch N_KIND(node) {
  80.  
  81.     case(as_insert):
  82.         N_SIDE(node) = FALSE;
  83.         FORTUP(node1 = (Node), N_LIST(node), ft1);
  84.             expand(node1);
  85.             N_SIDE(node) |= N_SIDE(node1);
  86.         ENDFORTUP(ft1);
  87.         node1 = N_AST1(node);
  88.         expand(node1);
  89.         N_SIDE(node) |= N_SIDE(node1);
  90.         break;
  91.  
  92.     /* Chapter 3. Declarations and types*/
  93.     /*
  94.      *-----------------
  95.      * 3.1 Declarations
  96.      */
  97.     case(as_declarations):
  98.         N_SIDE(node) = FALSE;
  99.         if (N_LIST(node) == (Tuple)0)
  100.             chaos("expand.c: as_declarations N_LIST null");
  101.         FORTUP(node1 = (Node), N_LIST(node), ft1);
  102.             expand(node1);
  103.             N_SIDE(node) |= N_SIDE(node1);
  104.         ENDFORTUP(ft1);
  105.         break;
  106.  
  107.     /*
  108.      *------------------------------
  109.      * 3.2 Objects and named numbers
  110.      */
  111.  
  112.     case(as_obj_decl):
  113.     case(as_const_decl):
  114.         expand_decl(node);
  115.         break;
  116.  
  117.     /*
  118.      *-----------------------
  119.      * 3.3 Types and subtypes
  120.      * 3.3.1
  121.      */
  122.     case(as_type_decl):
  123.         expand_type(node);
  124.         break;
  125.  
  126.     /* 3.3.2 */
  127.     case(as_subtype_decl):
  128.     expand_subtype(node);
  129.         break;
  130.  
  131.     case(as_delayed_type):
  132.         sym1 = N_UNQ(N_AST1(node)); /* type name */
  133.         sym2 = N_UNQ(N_AST2(node)); /* parent name */
  134.         node1 = copy_node(node);    /* delayed node */
  135.         if (NATURE(sym1) == na_subtype)
  136.             N_KIND(node1) = as_subtype_decl;
  137.         else
  138.             N_KIND(node1) = as_type_decl;
  139.         nk = emap_get(sym2); 
  140.         tup = EMAP_VALUE;
  141.         if (!nk)  /* emap_defined */
  142.             tup = tup_new1((char *) node1);
  143.         else
  144.             tup = tup_with(tup, (char *)node1);
  145.         /* EMAP(sym2) = (EMAP(sym2)?[]) with node1;*/
  146.         emap_put(sym2, (char *) tup);
  147.         delete_node(node);
  148.         break;
  149.  
  150.     case(as_subtype_indic):
  151.         sym1 = N_UNQ(N_AST1(node)); /* type name */
  152.         N_SIDE(node) = (unsigned)CONTAINS_TASK(sym1);
  153.         node2 = N_AST2(node); /* expression */
  154.         expand(node2);
  155.         N_SIDE(node) |= N_SIDE(node2);
  156.         break;
  157.     /*
  158.      *-----------------
  159.      * 3.5 Scalar types
  160.      */
  161.     case(as_digits):
  162.         expand(N_AST1(node)); /* precision node */
  163.         node2 = N_AST2(node); /* range node */
  164.         expand(node2);
  165.         N_SIDE(node) = N_SIDE(node2);
  166.         break;
  167.  
  168.     case(as_delta):
  169.         expand(N_AST1(node)); /* precision node */
  170.         node2 = N_AST2(node); /* range node */
  171.         expand(node2);
  172.         N_SIDE(node) = N_SIDE(node2);
  173.         break;
  174.  
  175.     case(as_subtype):
  176.         node2 = N_AST2(node);
  177.         expand(node2);
  178.         N_SIDE(node) = N_SIDE(node2);
  179.  
  180.         /* Transmit tasks_declared: */
  181.         sym1 = N_UNQ(N_AST1(node)); /* type name */
  182.         /* N_TYPE(node) is parent type */
  183.         CONTAINS_TASK(sym1) = CONTAINS_TASK(N_TYPE(node));
  184.         break;
  185.  
  186.     case(as_component_list):
  187.         node1 = N_AST1(node); /* invariant node */
  188.         FORTUP(node2 = (Node), N_LIST(node1), ft1);
  189.             expand(node2);     /* field node */
  190.         ENDFORTUP(ft1);
  191.         expand(N_AST2(node)); /* variant node */
  192.         N_SIDE(node) = FALSE;
  193.         break;
  194.  
  195.     case(as_simple_choice):
  196.         node1 = N_AST1(node); /* expression */
  197.         expand(node1);
  198.         N_SIDE(node) = N_SIDE(node1);
  199.         break;
  200.  
  201.     case(as_incomplete_decl):
  202.         sym1 = N_UNQ(N_AST1(node)); /* type name */
  203.         CONTAINS_TASK(sym1) = (char *) TRUE; /* May be. Future will tell */
  204.         delete_node(node);
  205.         break;
  206.  
  207.     /*
  208.      * Chapter 4. Names and expressions
  209.      *
  210.      *----------
  211.      * 4.1 Names
  212.      */
  213.     case(as_range_choice):
  214.         node1 = N_AST1(node);
  215.         if (N_KIND(node1) == as_attribute) {
  216.             /* must be range. */
  217.             sym1 = N_TYPE(node1);
  218.             nk = (int)attribute_kind(node1) - ATTR_RANGE;   /* 'T' or 'O'*/
  219.             attribute_kind(node1) = (char *) (nk + ATTR_FIRST);
  220.             N_AST2(node) = new_attribute_node(nk + ATTR_LAST,
  221.               N_AST2(node1), N_AST3(node1), sym1);
  222.             N_KIND(node) = as_range;
  223.             N_TYPE(node) = sym1;
  224.             expand(node);
  225.         }
  226.         else {
  227.             node2 = N_AST2(node1);
  228.             expand(node2);
  229.             N_SIDE(node) = N_SIDE(node2);
  230.         }
  231.         break;
  232.  
  233.     case(as_range):
  234.         node1 = N_AST1(node); /* expression */
  235.         node2 = N_AST2(node); /* expression */
  236.         expand(node1);
  237.         expand(node2);
  238.         N_SIDE(node) = N_SIDE(node1) | N_SIDE(node2);
  239.         break;
  240.  
  241.     case(as_constraint):
  242.         N_SIDE(node) = FALSE;
  243.         FORTUP(node1 = (Node), N_LIST(node), ft1);
  244.             if (N_KIND(node1) == as_choice_list) {
  245.                 /* named discriminant constraints. Only need expression. */
  246.                 node1 = N_AST2(node1) ;
  247.             }
  248.             expand(node1);
  249.             N_SIDE(node) |= N_SIDE(node1);
  250.         ENDFORTUP(ft1);
  251.         break;
  252.  
  253.     case(as_index):
  254.         node1 = N_AST1(node) ; /* array node */
  255.         expand(node1);
  256.         N_SIDE(node) = N_SIDE(node1);
  257.         /* N_AST2(node) is a list of indices */
  258.         FORTUP(node2 = (Node), N_LIST(N_AST2(node)), ft1);
  259.             expand(node2); /* index */
  260.             N_SIDE(node) |=  N_SIDE(node2);
  261.         ENDFORTUP(ft1);
  262.         break;
  263.  
  264.     /*
  265.      * 4.1.2
  266.      */
  267.     case(as_slice):
  268.         node2 = N_AST2(node) ; /* range node */
  269.  
  270.         if (N_KIND(node2) == as_subtype) {
  271.             /* remove subtype */
  272.             node1 = N_AST2(node2); /* id node */
  273.             copy_attributes(node1, node2);
  274.         }
  275.  
  276.         if (is_simple_name(node2)) {
  277.             /* type name replaced by range attribute */
  278.             /* SETL has OPT_NODE as third arg in next call. This is
  279.               * wrong - want to indicate first dimension.
  280.               *  ds    9-8-85
  281.               */
  282.             node2 = new_attribute_node(ATTR_T_RANGE, node2,
  283.               new_ivalue_node(int_const(1), symbol_integer), N_UNQ(node2));
  284.             N_AST2(node) = node2 ;
  285.         }
  286.         node1 = N_AST1(node) ; /* array node */
  287.         expand(node1);
  288.         N_SIDE(node) = N_SIDE(node1);
  289.         expand(node2);         /* range node */
  290.         N_SIDE(node) |= N_SIDE(node2);
  291.         break;
  292.  
  293.     case(as_field):
  294.         node2 = N_AST2(node) ; /* expression */
  295.         expand(node2);
  296.         N_SIDE(node) = N_SIDE(node2);
  297.         break;
  298.  
  299.     case(as_selector):
  300.     case(as_all):
  301.         node1 = N_AST1(node) ; /* expression */
  302.         expand(node1);
  303.         N_SIDE(node) = N_SIDE(node1);
  304.         break;
  305.  
  306.     /*
  307.      * 4.1.4
  308.      */
  309.     case(as_attribute):
  310.     case(as_range_attribute):
  311.         expand_attr(node);
  312.         break;
  313.  
  314.     /*
  315.      *-------------
  316.      * 4.2 Literals
  317.      */
  318.     case(as_string_ivalue):
  319.         expand_string(node);
  320.         break;
  321.  
  322.     case(as_int_literal):
  323.         /* TBSL(JC) This is a kludge */
  324.         N_KIND(node) = as_ivalue;
  325.         lv = adaval(symbol_integer, N_VAL(node));
  326.         if (adaval_overflow)
  327.             chaos("unable to convert integer literal");
  328.         else
  329.             N_VAL(node) = (char *) lv;
  330.         N_SIDE(node) = FALSE;
  331.         break;
  332.  
  333.     /*
  334.      *---------------
  335.      * 4.3 Aggregates
  336.      */
  337.     case(as_array_aggregate):
  338. #ifdef DEFER
  339.         /* N_LIST assignmentnot needed in packed version  DS 3-86 */
  340.         N_LIST(node) = (Tuple)0;    /* Useless information removed */
  341. #endif
  342.         expand_array_aggregate(node) ;
  343.         N_SIDE(node) = N_KIND(node) != as_array_ivalue;
  344.         /* TBSL better N_SIDE */
  345.         break;
  346.  
  347.     case(as_row):
  348.         node1 = N_AST1(node); /* expression */
  349.         if (is_ivalue(node1) && root_type(N_TYPE(node1)) == symbol_character) {
  350.             /* Transform into string litteral */
  351.             /* Clear current AST_3 and AST_4 only if defined, thus preserving
  352.               * any N_UNQ and N_TYPE values if these are defined for the node.
  353.               */
  354.             if (N_AST3_DEFINED(N_KIND(node))) N_AST3(node) = (Node) 0;
  355.             if (N_AST4_DEFINED(N_KIND(node))) N_AST4(node) = (Node) 0;
  356.             N_KIND(node) = as_string_ivalue;
  357.             N_AST1(node) = (Node)0;
  358.             N_AST2(node) = (Node)0;
  359.             /* TBSL: check translation of following carefully */
  360.             N_VAL(node) = (char *) tup_new1((char *) get_ivalue_int(node1));
  361.         }
  362.         else {
  363.             /* Transform into an aggregate */
  364.             N_KIND(node) = as_array_aggregate;
  365.             /* positionnal */
  366.             node3 = node_new(as_aggregate_list);
  367.             node2         = node_new(as_list); /* positionnal */
  368.             N_LIST(node2) = tup_new1((char *) node1);
  369.             N_AST1(node3)  = node2 ;
  370.             /* named */
  371.             node2         = node_new(as_list); /* named */
  372.             N_LIST(node2) = tup_new(0);
  373.             N_AST2(node3)  = node2 ;
  374.             N_AST1(node) = node3;
  375.  
  376.             N_AST2(node)  = OPT_NODE ;
  377.             N_UNQ (node)  = new_unique_name("row");
  378.         }
  379.         expand(node);
  380.         break;
  381.  
  382.     case(as_record_aggregate):
  383.         expand_record_aggregate(node);
  384.         N_SIDE(node) = N_KIND(node) != as_record_ivalue;
  385.         /* TBSL better N_SIDE */
  386.         break;
  387.  
  388.     /*
  389.      *----------------
  390.      * 4.4 Expressions
  391.      */
  392.  
  393.     /*
  394.      *----------------------------------------
  395.      * 4.5 Operators and expression evaluation
  396.      */
  397.     case(as_op):
  398.         expand_op(node);
  399.         break;
  400.  
  401.     case(as_un_op):
  402.         node2 = N_AST2(node) ; /* arguments */
  403.         node1 = (Node) ((Tuple) N_LIST(node2)[1]);
  404.         expand(node1);
  405.         N_SIDE(node) = N_SIDE(node1);
  406.         break;
  407.  
  408.     /*
  409.      *---------------------
  410.      * 4.6 Type conversions
  411.      */
  412.     case(as_qual_range):
  413.     case(as_qual_discr):
  414.     case(as_qual_sub):
  415.         node1 = N_AST1(node) ; /* expression */
  416.         expand(node1);
  417.  
  418.         /* Note: must expand before checking types, as actual subtype of */
  419.         /* aggregates may be determined by expansion. */
  420.         sym1 = N_TYPE(node); /* qualification type */
  421.         if (sym1 == get_type(node1) || is_unconstrained(sym1)) {
  422.             /* remove qual */
  423.             copy_attributes(node1, node);
  424.         }
  425.         else {
  426.             N_SIDE(node) = N_SIDE(node1);
  427.         }
  428.         break;
  429.  
  430.     case(as_qual_index):
  431.         node1 = N_AST1(node); /* expression */
  432.         expand(node1);
  433.         sym1 = N_TYPE(node); /* qualification type */
  434.         sym2 = get_type(node1);
  435.         if (sym1 == sym2 || is_unconstrained(sym1)) {
  436.             /* remove qual */
  437.             copy_attributes(node1, node);
  438.         }
  439.         else {
  440.             /* tup_copy needed since index_types tuple used here
  441.               * destructiely  ds 6-25-85
  442.               */
  443.             /* TBSL (JC) no copy needed. use FORTUPI */
  444.             tup1 = tup_copy(index_types(sym1));
  445.             tup2 = tup_copy(index_types(sym2));
  446.             cboolean = TRUE;
  447.             while (tup_size(tup1)) {
  448.                 sym3 = (Symbol) tup_fromb(tup1);
  449.                 sym4 = (Symbol) tup_fromb(tup2);
  450.                 node2 = (Node) ((Tuple) SIGNATURE(sym3)[2]); /* lower bound */
  451.                 node3 = (Node) ((Tuple) SIGNATURE(sym3)[3]); /* upper bound */
  452.                 lbd_1 = get_ivalue(node2);
  453.                 ubd_1 = get_ivalue(node3);
  454.                 node2 = (Node) ((Tuple) SIGNATURE(sym4)[2]); /* lower bound */
  455.                 node3 = (Node) ((Tuple) SIGNATURE(sym4)[3]); /* upper bound */
  456.                 lbd_2 = get_ivalue(node2);
  457.                 ubd_2 = get_ivalue(node3);
  458.                 if (N_KIND(node1) != as_slice && !is_unconstrained(sym2)
  459.                   && lbd_1->const_kind != CONST_OM
  460.                   && ubd_1->const_kind != CONST_OM
  461.                   && lbd_2->const_kind != CONST_OM
  462.                   && ubd_2->const_kind != CONST_OM) {
  463.                     lbd_1_val = INTV(lbd_1); 
  464.                     ubd_1_val = INTV(ubd_1);
  465.                     lbd_2_val = INTV(lbd_2); 
  466.                     ubd_2_val = INTV(ubd_2);
  467.                     if ((ubd_1_val - lbd_1_val) != (ubd_2_val - lbd_2_val)) {
  468.                         make_raise_node(node, symbol_constraint_error);
  469.                         USER_WARNING("Evaluation of expression will raise",
  470.                           " CONSTRAINT_ERROR");
  471.                         cboolean = FALSE;
  472.                         break;
  473.                     }
  474.                     if ((ubd_1_val != ubd_2_val) || (lbd_1_val != lbd_2_val)) {
  475.                         cboolean = FALSE;
  476.                         break;
  477.                     }
  478.                 }
  479.                 else { /* non static */
  480.                     cboolean = FALSE;
  481.                     break;
  482.                 }
  483.             } /* end loop */
  484.             if (cboolean) {
  485.                 /* qual_index can be removed */
  486.                 copy_attributes(node1, node);
  487.                 N_TYPE(node) = sym1;
  488.                 if (is_aggregate(node))  {
  489.                     node2 = N_AST2(node); /* object node */
  490.                     TYPE_OF(N_UNQ(node2)) = sym1;
  491.                 }
  492.                 else if (N_KIND(node)==as_insert && is_aggregate(N_AST1(node))){
  493.                     node2 = N_AST2(N_AST1(node)); /* object node */
  494.                     TYPE_OF(N_UNQ(node2)) = sym1;
  495.                 }
  496.             }
  497.             else {
  498.                 N_SIDE(node) = N_SIDE(node1);
  499.             }
  500.         }
  501.         break;
  502.  
  503.     case(as_qual_aindex):
  504.     case(as_qual_alength):
  505.     case(as_qual_adiscr):
  506.         node1 = N_AST1(node) ; /* expression */
  507.         expand(node1);
  508.         if (N_KIND(node1) == as_null) {
  509.             /* remove qual */
  510.             copy_attributes(node1, node);
  511.         }
  512.         else {
  513.             N_SIDE(node) = N_SIDE(node1);
  514.         }
  515.         break;
  516.  
  517.     case(as_convert):
  518.         /* The target type of the conversion is the type of the node */
  519.         /* The source type is the type of the expression itself. */
  520.         node2 = N_AST2(node) ; /* expression */
  521.  
  522.         /* Special case: convert of a fixed point * or / */
  523.         if (N_KIND(node2) == as_op && (op_kind(node2) == symbol_mulfx
  524.           || op_kind(node2) == symbol_divfx)) {
  525.  
  526.             /* Bind result type to the operation and remove node */
  527.             N_TYPE(node2) = N_TYPE(node);
  528.             copy_attributes(node2, node);
  529.             expand(node);
  530.         }
  531.         else {
  532.             expand(node2);
  533.             N_SIDE(node) = N_SIDE(node2);
  534.  
  535.             /* Remove unnecessary conversion */
  536.             if ((base_type(get_type(node2)) == base_type(N_TYPE(node))
  537.               && !is_unconstrained(base_type(N_TYPE(node))))
  538.               || ((root_type(get_type(node2)) == root_type(N_TYPE(node)))
  539.               && (is_discrete_type (root_type (get_type (node2)))))) {
  540.                 /*copy_attributes(node2, node); */
  541.                 N_KIND (node) = as_qual_range;
  542.                 N_AST1 (node) = N_AST2 (node);
  543.             }
  544.         }
  545.         break;
  546.  
  547.     case(as_arg_convert):
  548.         /*    The target type of the conversion is the type of the node
  549.          *    The source type is the type of the expression itself.
  550.          *    src_type    = get_type(node2) ;
  551.          *    target_type = N_TYPE(node);
  552.          */
  553.         node2 = N_AST2(node) ; /* expression */
  554.         expand(node2);
  555.         N_SIDE(node) = N_SIDE(node2);
  556.         break;
  557.  
  558.     /*
  559.      *---------------
  560.      * 4.8 Allocators
  561.      */
  562.     case(as_new):
  563.         node1 = N_AST1(node) ; /* id node */
  564.         node2 = N_AST2(node) ; /* expression */
  565.         sym1  = N_UNQ(node1) ; /* allocated type */
  566.         /* N_TYPE(node) is the type of the context */
  567.         sym2 = (Symbol) designated_type(N_TYPE(node)); /* accessed type */
  568.  
  569.         if (is_task_type(sym2)) {
  570.             node2 = new_create_task_node(sym2);
  571.             N_AST2(node) = node2 ;
  572.         }
  573.         else if ( is_access_type(sym2) && node2 == OPT_NODE) {
  574.             node2 = node_new(as_null);
  575.             N_AST2(node) = node2 ;
  576.         }
  577.  
  578.         expand(node2);
  579.  
  580.         if (!is_simple_name(node1)) {
  581.             /* There is a subtype to emit */
  582.             expand(node1);
  583.             make_insert_node(node, tup_new1((char *) node1), copy_node(node));
  584.             node = N_AST1(node);
  585.         }
  586.         else if ( is_unconstrained(sym1)) {
  587.             /* Establish proper subtype */
  588.             if (is_array_type(sym1)) {
  589.                 /* Take constraint from initial value (always present in */
  590.                 /* this case) */
  591.                 sym1 = get_type(node2);
  592.                 N_UNQ(node1) = sym1;
  593.             }
  594.             else if (node2 == OPT_NODE) {  /* record */
  595.                 /* Create a subtype, constrained by default values. (Default
  596.                  * values always present in that case). 
  597.                  */
  598.                 sym1 = new_unique_name("constrained_type");
  599.                 N_UNQ(node1) = sym1;
  600.                 tup1 = constraint_new(co_discr);
  601.                 tup = tup_new(0);
  602.                 FORTUP(sym4 = (Symbol), discriminant_list_get(sym2), ft1);
  603.                     /* An allocator is always constrained. Set the constrained
  604.                     * bit accordingly
  605.                     */
  606.                     if (sym4 == symbol_constrained)
  607.                         tup = discr_map_put(tup, sym4, 
  608.                           new_ivalue_node(int_const(TRUE), symbol_boolean));
  609.                     else
  610.                         tup = discr_map_put(tup, sym4, 
  611.                           copy_tree((Node) default_expr(sym4)));
  612.                 ENDFORTUP(ft1);
  613.                 tup1[2] = (char *) tup;
  614.                 new_symbol(sym1, na_subtype, sym2, tup1,
  615.                   root_type(sym2));
  616.                 node1 = new_subtype_decl_node(sym1);
  617.                 expand(node1);
  618.                 make_insert_node(node,tup_new1((char *)node1), copy_node(node));
  619.                 node = N_AST1(node);
  620.             }
  621.             else if ( !is_unconstrained(get_type(node2))) {
  622.                 /* Use expression subtype for allocated object */
  623.                 sym3 = get_type(node2);
  624.                 N_UNQ(node1) = sym3;
  625.             }
  626.             else {
  627.                 /* Worst case: new REC'(F), where REC is unconstrained, and F
  628.                  * returns REC. The subtype must be elaborated from the value
  629.                  * of discriminants of the expression.
  630.                  */
  631.                 sym3 = get_type(node2);
  632.                 sym1 = new_unique_name("constrained_type");
  633.                 N_UNQ(node1) = sym1;
  634.                 /* tup1 = [co_discr, {} ];*/
  635.                 tup1 = constraint_new(co_discr);
  636.                 tup1[2] = (char *) tup_new(0);
  637.                 new_symbol(sym1, na_subtype, sym2, tup1,
  638.                   root_type(sym2));
  639.                 CONTAINS_TASK(sym1) = CONTAINS_TASK(sym2);
  640.  
  641.                 node3         = node_new(as_type_and_value);
  642.                 N_AST1(node3) = new_name_node(sym1) ;
  643.                 N_AST2(node3) = node2 ;
  644.                 N_TYPE(node3) = sym3;
  645.                 N_AST1(node)  = node1 ;
  646.                 N_AST2(node)  = node3 ;
  647.                 if (N_AST3_DEFINED(N_KIND(node))) N_AST3(node) = (Node) 0;
  648.                 if (N_AST4_DEFINED(N_KIND(node))) N_AST4(node) = (Node) 0;
  649.             }
  650.         }
  651.         sym3 = INIT_PROC(base_type(sym2));
  652.         if (node2 == OPT_NODE && sym3 != (Symbol)0) {
  653.             node2 = build_init_call(OPT_NODE, sym3, sym1, OPT_NODE);
  654.             expand(node2);
  655.             N_AST1(node) = node1 ;
  656.             N_AST2(node) = node2;
  657.             if (N_AST3_DEFINED(N_KIND(node))) N_AST3(node) = (Node) 0;
  658.             if (N_AST4_DEFINED(N_KIND(node))) N_AST4(node) = (Node) 0;
  659.         }
  660.         N_SIDE(node) = TRUE;
  661.         break;
  662.  
  663.         /** Chapter 5. Statements */
  664.  
  665.     case(as_null_s):
  666.         break;
  667.  
  668.     case(as_line_no):
  669.         ada_line     = (int) N_VAL(node);
  670.         N_SIDE(node) = FALSE;
  671. #ifdef TRACE
  672.         if (debug_line>0 && ada_line >= debug_line) {
  673.             expand_line();
  674.         }
  675. #endif
  676.         break;
  677.     
  678.     /*
  679.      *-----------------------------------
  680.      * 5.1 Simple and compound statements
  681.      */
  682.     case(as_statement):
  683.         /* This node is used only for labelled statements, in front */
  684.         /* of which labels are emitted. */
  685.         expand(N_AST2(node)) ;
  686.         break;
  687.  
  688.     case(as_statements):
  689.         node1 = N_AST1(node) ; /* statements node */
  690.         /* Note that if cboolean is true, the statement is not reachable 
  691.          * and therefore can be removed. TBSL: remove it from the list.
  692.          */
  693.         cboolean = FALSE; /* first statement is always reachable */
  694.         FORTUP(node2 = (Node), N_LIST(node1), ft1);
  695.             if (N_KIND(node2) == as_statement)
  696.                 cboolean = FALSE;
  697.             if (cboolean)
  698.                 delete_node(node2);
  699.             else
  700.                 expand(node2);
  701.             if (  N_KIND(node2) == as_raise 
  702.               || N_KIND(node2) == as_goto
  703.               || N_KIND(node2) == as_return 
  704.               || N_KIND(node2) == as_end
  705.               || N_KIND(node2) == as_terminate)
  706.             cboolean = TRUE;
  707.         ENDFORTUP(ft1);
  708.         break;
  709.  
  710.     /*
  711.      *-------------------------
  712.      * 5.2 Assignment statement
  713.      */
  714.     case(as_assignment):
  715.         expand(N_AST1(node)) ; /* variable node */
  716.         expand(N_AST2(node)) ; /* expression */
  717.         break;
  718.  
  719.     /*
  720.      *------------------
  721.      *  5.3 If statement
  722.      */
  723.     case(as_if):
  724.         node1 = N_AST1(node) ; /* if list node */
  725.         node2 = N_AST2(node) ; /* else part */
  726.  
  727.         /* Remove branches guarded by static expressions */
  728.         /* (conditional compilation) */
  729.         tup = tup_new(0);
  730.         FORTUP(node3 = (Node), N_LIST(node1), ft1);
  731.             node4 = N_AST1(node3) ; /* condition */
  732.             expand(node4);
  733.  
  734.             if (is_ivalue(node4)) {
  735.                 if (get_ivalue_int(node4) == TRUE) {
  736.                     /* This branch is guarded by TRUE: becomes the else part.
  737.                        * All others branches are no longer reachable and
  738.                         * may therefore be discarded.
  739.                         */
  740.                     node2 = N_AST2(node3);
  741.                     break;
  742.                 }
  743.                 /* else FALSE: skip this node */
  744.             }
  745.             else {
  746.                 expand(N_AST2(node3));
  747.                 tup = tup_with(tup, (char *) node3);
  748.             }
  749.         ENDFORTUP(ft1);
  750.  
  751.         expand(node2); /* else part */
  752.  
  753.         if (tup_size(tup) == 0) {
  754.             if (node2 == OPT_NODE)
  755.                 delete_node(node);
  756.             else
  757.                 copy_attributes(node2, node);
  758.         }
  759.         else {
  760.             N_LIST(node1) = tup;
  761.             N_AST1(node)  = node1 ;
  762.             N_AST2(node)  = node2 ;
  763.         }
  764.         break;
  765.  
  766.     /*
  767.      *--------------------
  768.      * 5.4 Case statements
  769.      */
  770.  
  771.     case(as_case):
  772.     case(as_variant_decl):
  773.         expand(N_AST1(node)) ; /* expression */
  774.         tup1 = tup_copy(N_LIST(N_AST2(node))) ;
  775.         /* tup_copy needed since tup1 used destructively
  776.          * in tup_fromb below  ds 6-25-85 
  777.          */
  778.         if (tup_size(tup1) == 1) {
  779.             /* Only one case... suppress case statement */
  780.             node1 = (Node) tup_fromb(tup1); /* case branch */
  781.             /* N_AST2(node1) is the list of statements for that branch */
  782.             copy_attributes(N_AST2(node1), node);
  783.             expand(node);
  784.         }
  785.         else {
  786.             FORTUP(node1 = (Node), tup1, ft1);
  787.                 /* node1 is case node */
  788.                 node2 = N_AST1(node1) ; /* list of choices */
  789.                 expand(N_AST2(node1)) ; /* statements node */
  790.                 FORTUP(node1 = (Node), N_LIST(node2), ft2);
  791.                     /* in the inner loop node1 is choice node */
  792.                     nk = N_KIND(node1);
  793.                     if (nk == as_range_choice) {
  794.                         node3 = N_AST1(node1); /* id node */
  795.                         node4 = N_AST2(node3); /* range node */
  796.                         N_AST1(node1) = N_AST1(node4);
  797.                         N_AST2(node1) = N_AST2(node4);
  798.                         N_AST3(node1) = N_AST3(node4);
  799.                         N_AST4(node1) = N_AST4(node4);
  800.                         N_KIND(node1) = as_range;
  801.                     }
  802.                     else if (nk == as_simple_name) {
  803.                         sym1 = N_UNQ(node1); /* type name */
  804.                         tup = (Tuple) get_constraint(sym1);
  805.                         N_AST1(node1) = (Node) tup[2] ; /* lower bound */
  806.                         N_AST2(node1) = (Node) tup[3] ; /* upper bound */
  807.                         N_KIND(node1) = as_range;
  808.                     }
  809.                     else if (nk == as_simple_choice) {
  810.                         node3 = N_AST1(node1); /* lower bound */
  811.                         N_AST1(node1) = node3 ;
  812.                         N_AST2(node1) = node3 ;
  813.                         N_KIND(node1) = as_range;
  814.                     }
  815.                     else if (nk == as_others_choice || nk == as_range) {
  816.                         ;
  817.                     }
  818.                     else {
  819.                         compiler_error_k(
  820.                           "Unexpected choice in case statement: ", node1);
  821.                     }
  822.                 ENDFORTUP(ft2);
  823.             ENDFORTUP(ft1);
  824.         }
  825.         break;
  826.  
  827.     /*
  828.      *--------------------
  829.      * 5.5 Loop statements
  830.      */
  831.  
  832.     case(as_loop):
  833.         node1 = N_AST1(node) ; /* id node */
  834.         node2 = N_AST2(node) ; /* iteration scheme */
  835.         if (node2 != OPT_NODE) {
  836.             expand(node2) ;
  837.             if (N_KIND(node2) == as_insert) {
  838.                 propagate_insert(node2, node);
  839.                 node = N_AST1(node);
  840.             }
  841.         }
  842.         nk = N_KIND(node2);
  843.         if (nk == as_deleted)
  844.             delete_node(node);
  845.         else if (nk == as_raise)
  846.             copy_attributes(node2, node);
  847.         else { /* normal case */
  848.             if (node1 != OPT_NODE) {
  849.                 sym1 = N_UNQ(node1); /* loop name */
  850.                 SIGNATURE(sym1) = (Tuple) FALSE;
  851.             }
  852.             expand(N_AST3(node)); /* statements */
  853.             if (node1 != OPT_NODE) {
  854.                 /* Remove id node if not used */
  855.                 sym1 = N_UNQ(node1);
  856.                 if (is_generated_label(sym1) &&
  857.                     SIGNATURE(sym1) == (Tuple) FALSE) {
  858.                     N_AST1(node) = OPT_NODE ;
  859.                 }
  860.             }
  861.         }
  862.         break;
  863.  
  864.     case(as_while):
  865.         expand(N_AST1(node)); /* condition node */
  866.         break;
  867.  
  868.     case(as_for):
  869.     case(as_forrev):
  870.         expand_for(node);
  871.         break;
  872.     
  873.     /*
  874.      *---------------------
  875.      * 5.6 Block statements
  876.      */
  877.  
  878.     case(as_block):
  879.         node1 = N_AST1(node) ; /* id node */
  880.         /* N_AST2(node) declaration node */
  881.         /* N_AST3(node) statements node */
  882.         /* N_AST4(node) handler node */
  883.         if (is_simple_name(node1) && (N_UNQ(node1) == symbol_task_block)) {
  884.             node2 = node_new(as_terminate); /* terminal node */
  885.             tup = tup_new(2); 
  886.             tup[1] = 0; 
  887.             tup[2] = 0;
  888.             N_VAL(node2) = (char *) tup;
  889.         }
  890.         else {
  891.             node2 = node_new(as_end);       /* terminal node */
  892.         }
  893.         expand_block(N_AST2(node), N_AST3(node), N_AST4(node), node2);
  894.         break;
  895.  
  896.     case(as_end):
  897.         break;
  898.  
  899.     /*
  900.      *--------------------
  901.      * 5.7 Exit statements
  902.      */
  903.  
  904.     case(as_exit):
  905.         expand(N_AST2(node)); /* condition node */
  906.         sym1 = N_UNQ(node); /* loop name */
  907.         SIGNATURE(sym1) = (Tuple) TRUE;
  908.         break;
  909.  
  910.     /*
  911.      *----------------------
  912.      * 5.8 Return statements
  913.      */
  914.  
  915.     case(as_return):
  916.         node1 = N_AST1(node) ; /* expression */
  917.         if (node1 != OPT_NODE)
  918.             expand(node1);
  919.         break;
  920.  
  921.     /*
  922.      *--------------------
  923.      * 5.9 Goto statements
  924.      */
  925.     case(as_goto):
  926.         break;
  927.  
  928.     /* Chapter 6. Subprograms */
  929.     /*
  930.      *---------------------------
  931.      * 6.0 Predefined subprograms
  932.      */
  933.  
  934.     case(as_predef):
  935.         sym1 = N_UNQ(node);     /* procedure name */
  936.         sym2 = N_TYPE(node);    /* type name */
  937.         tup = tup_new(2);
  938.         tup[1] = (char *) N_VAL(node);
  939.         /* integer mapped to the marker name */
  940.         tup[2] = (char *) sym2;
  941.         MISC(sym1) = (char *) tup;
  942.         N_SIDE(node) = FALSE;
  943.         break;
  944.  
  945.     case(as_interfaced):
  946.         sym1 = N_UNQ(node);     /* procedure name */
  947.         node1 = N_AST1(node);
  948.         tup = tup_new(2);
  949.         tup[1] = (char *) interface_counter++;  /* integer mapped to the
  950.                                                        interfaced subprogram */
  951.         /* the tuple interfaced_procedures consists of unit numbers of
  952.          * interfaced procedures followed by a string which contains
  953.          * the call to this interfaced procedure
  954.          */
  955.         interfaced_procedures = tup_with(interfaced_procedures,
  956.           (char *) unit_number_now);
  957.         if (streq(N_VAL(node1), "C")) {
  958.             interfaced_procedures = tup_with(interfaced_procedures,
  959.               c_interface(sym1, (int) tup[1]));
  960.         }
  961.         else {
  962.             interfaced_procedures = tup_with(interfaced_procedures,
  963.               fortran_interface(sym1, (int) tup[1]));
  964.         }
  965.         MISC(sym1) = (char *) tup;
  966.         N_SIDE(node) = FALSE;
  967.         break;
  968.  
  969.     /*
  970.      *----------------------
  971.      * 6.3 Subprogram bodies
  972.      */
  973.  
  974.     case(as_subprogram_tr):
  975.         /* N_AST1(node) statements */
  976.         /* N_AST2(node) declarations */
  977.         /* N_AST4(node) handler */
  978.         /* unique name of subprogram is now in the N_UNQ field of node. */
  979.         sym1 = N_UNQ(node) ; /* subprogram name */
  980.  
  981.         if (NATURE(sym1) == na_procedure || NATURE(sym1) == na_procedure_spec) {
  982.             /* Terminal node = return; */
  983.             node2 = node_new(as_return);
  984.             N_AST1(node2) = OPT_NODE ;
  985.             N_AST2(node2) = new_name_node(sym1) ;
  986.             N_AST3(node2) = new_number_node(0); /* depth */
  987.         }
  988.         else if (NATURE(sym1) == na_function
  989.           || NATURE(sym1) == na_function_spec) {
  990.             /* Terminal node = raise PROGRAM_ERROR */
  991.             node2 = new_raise_node(symbol_program_error);
  992.         }
  993.         else {     /* Task */
  994.             node2 = node_new(as_terminate);
  995.             tup = tup_new(2); 
  996.             tup[1] = 0; 
  997.             tup[2] = 0;
  998.             N_VAL(node2) = (char *) tup;
  999.         }
  1000.  
  1001.         /* The statement node is now in the N_AST1 field of node instead
  1002.          * of N_AST3 field as it was when the node was as_subprogram
  1003.          */
  1004.         expand_block(N_AST2(node), N_AST1(node), N_AST4(node), node2) ;
  1005.         N_SIDE(node) = TRUE;
  1006.         break;
  1007.  
  1008.     /*
  1009.      *---------------------
  1010.      * 6.4 Subprogram calls
  1011.      */
  1012.  
  1013.     case(as_call):
  1014.     case(as_init_call):
  1015.         node1 = N_AST1(node) ; /* procedure id */
  1016.         node2 = N_AST2(node) ; /* list of arguments */
  1017.         sym1  = N_UNQ(node1) ; /* prcedure name */
  1018.         /* The following if statement is not in SETL source but was added
  1019.          * to C version to fix renaming problem    ds 7-9-85
  1020.          */
  1021.         if (ALIAS(sym1) != (Symbol)0) {
  1022.             sym1 = ALIAS(sym1);
  1023.             N_UNQ(node1) = sym1;
  1024.         }
  1025.         if (in_bin_ops(sym1)) {
  1026.             N_KIND(node) = as_op;
  1027.             expand(node);
  1028.         }
  1029.         else if (in_un_ops(sym1)) {
  1030.             N_KIND(node) = as_un_op;
  1031.             expand(node);
  1032.         }
  1033.         else {
  1034.             FORTUP(node1 = (Node), N_LIST(node2), ft1);
  1035.             expand(node1);
  1036.             ENDFORTUP(ft1);
  1037.             N_SIDE(node) = TRUE;
  1038.         }
  1039.         break;
  1040.  
  1041.     /*
  1042.      * Chapter 7. Packages
  1043.      *--------------------------------------------
  1044.      * 7.2 Package specifications and declarations
  1045.      */
  1046.  
  1047.     case(as_package_spec):
  1048.         /*Swap in symbol table private declarations with full declarations */
  1049.         sym1  = N_UNQ(N_AST1(node)) ; /* package name */
  1050.         private_install(sym1);
  1051.  
  1052.         node2 = N_AST2(node) ; /* declarations node */
  1053.         node3 = N_AST3(node) ; /* private declarations */
  1054.         expand(node2);
  1055.         expand(node3);
  1056.  
  1057.         N_SIDE(node) = N_SIDE(node2) | N_SIDE(node3);
  1058.         break;
  1059.  
  1060.     /*
  1061.      *-------------------
  1062.      * 7.3 Package bodies
  1063.      */
  1064.  
  1065.     case(as_package_body):
  1066.         /* N_AST2(node) declarations */
  1067.         /* N_AST3(node) statements */
  1068.         /* N_AST4(node) handler */
  1069.         sym1 = N_UNQ(N_AST1(node)); /* package name */
  1070.  
  1071.         ud = unit_decl_get(unit_name);
  1072.         sym2 = ud->ud_unam; /* unit package */
  1073.         if (sym2 == sym1) { /* library unit */
  1074.  
  1075.             node4 = node_new(as_return);
  1076.             N_AST1(node4) = OPT_NODE;
  1077.             N_AST2(node4) = N_AST1(node);
  1078.             N_AST3(node4) = new_number_node(0); /* depth */
  1079.         }
  1080.         else {
  1081.             node4 = node_new(as_end);
  1082.         }
  1083.  
  1084.         if (N_AST3(node) == OPT_NODE) { /* statements */
  1085.             N_AST3(node) = new_statements_node(tup_new(0));
  1086.         }
  1087.  
  1088.         expand_block(N_AST2(node), N_AST3(node), N_AST4(node), node4);
  1089.         N_SIDE(node) = N_SIDE(N_AST2(node));
  1090.         break;
  1091.  
  1092.     /*
  1093.      *----------------------------------------------------
  1094.      * 7.4 Private type and deferred constant declarations
  1095.      */
  1096.  
  1097.     case(as_use):
  1098.         delete_node(node);
  1099.         break;
  1100.  
  1101.     /*
  1102.      * Chapter 8. Visibility rules
  1103.      *--------------------------
  1104.      * 8.5 Renaming declarations
  1105.      */
  1106.     case(as_rename_obj):
  1107.         node1 = N_AST3(node) ; /* object node */
  1108.         expand(node1);
  1109.         N_SIDE(node) = N_SIDE(node1);
  1110.         break;
  1111.  
  1112.     case(as_rename_sub_tr):
  1113.         node2 = N_AST2(node) ; /* definition node */
  1114.         sym1  = N_UNQ(node) ; /* procedure name */
  1115.         tup1  = tup_copy(SIGNATURE(sym1));
  1116.         /* tup_copy needed since tup1 used in tup_fromb below */
  1117.  
  1118.         nk = N_KIND(node2);
  1119.         if (nk == as_attribute) {
  1120.             node2 = copy_node(node2); /* attribute node */
  1121.             sym3 = (Symbol) tup_fromb(tup1);
  1122.             N_AST2(node2) = new_name_node(TYPE_OF(sym3)) ;
  1123.             N_AST3(node2) = new_name_node(sym3) ;
  1124.             N_TYPE(node2) = TYPE_OF(sym1);
  1125.             node3 = node_new(as_return); /* return node */
  1126.             N_AST1(node3) = node2 ;
  1127.             N_AST2(node3) = new_name_node(sym1) ;
  1128.             N_AST3(node3) = new_number_node(0); /* depth */
  1129.             make_subprog_node(node, sym1, OPT_NODE,
  1130.               new_statements_node(tup_new1((char *)node3)), OPT_NODE);
  1131.             expand(node);
  1132.         }
  1133.         else if (nk == as_entry_name) {
  1134.             node3 = node_new(as_ecall);       /* entry call */
  1135.             N_AST1(node3) = copy_node(node2); /* entry node */
  1136.             node2 = node_new(as_list);        /* arguments node */
  1137.             tup = tup_new(tup_size(tup1));
  1138.             FORTUPI(sym4 = (Symbol), tup1, nk, ft1);
  1139.                 tup[nk] = (char *) new_name_node(sym4);
  1140.             ENDFORTUP(ft1);
  1141.             N_LIST(node2) = tup;
  1142.             N_AST2(node3) = node2;
  1143.             make_subprog_node(node, sym1, OPT_NODE,
  1144.               new_statements_node(tup_new1((char *)node3)), OPT_NODE);
  1145.             expand(node);
  1146.         }
  1147.         else if (nk == as_simple_name) {
  1148.             /* handled fully by front-end. */
  1149.             delete_node(node);
  1150.         }
  1151.         else {
  1152.             compiler_error_k("Unknown kind in subprogram renaming: ", node2);
  1153.         }
  1154.         break;
  1155.  
  1156.     /*
  1157.      * Chapter 9. Tasks
  1158.      *----------------------------------------
  1159.      * 9.1 Task specifications and task bodies
  1160.      */
  1161.  
  1162.     case(as_task_spec):
  1163.         /* Separate declaration of the object from declaration of the type */
  1164.         sym1 = N_TYPE(node);   /* task type */
  1165.         sym2 = N_UNQ(node);    /* task name */
  1166.         node1 = copy_node(node); /* id node */
  1167.         N_KIND(node1) = as_task_type_spec;
  1168.         make_insert_node(node, tup_new1((char *) node1),
  1169.           new_var_node(sym2, sym1, OPT_NODE));
  1170.         new_symbol(sym2, na_obj, sym1, (Tuple)0, (Symbol)0);
  1171.         expand(node);
  1172.         break;
  1173.  
  1174.     case(as_task_type_spec):
  1175.         /* Add the subprogram spec declaration in front
  1176.          * and transform into type node.
  1177.          */
  1178.         node2 = N_AST2(node); /* entries node */
  1179.         sym1 = N_TYPE(node); /* task type */
  1180.         sym2 = new_unique_name("task_init_proc"); /* associated procedure */
  1181.         assoc_symbol_put(sym1, TASK_INIT_PROC, sym2);
  1182.         CONTAINS_TASK(sym1) = (char *) TRUE;
  1183.         FORTUP(node1 = (Node), N_LIST(node2), ft1);
  1184.             expand(node1); /* entry node */
  1185.         ENDFORTUP(ft1);
  1186.         NATURE   (sym2) = na_task_body;
  1187.         TYPE_OF  (sym2) = symbol_none;
  1188.         SIGNATURE(sym2) = tup_new(0);
  1189.         generate_object(sym2); /* associated procedure */
  1190.         SIGNATURE(sym1) = N_LIST(node2);
  1191.  
  1192.         node2 = node_new(as_subprogram_decl_tr); /* subprogram node */
  1193.         N_UNQ(node2) = sym2;
  1194.         expand(node2);
  1195.         N_KIND(node) = as_type_decl;
  1196.         N_AST1(node) = new_name_node(sym1);
  1197.         N_AST2(node) = N_AST3(node) = (Node) 0;
  1198.         if (N_AST4_DEFINED(as_type_decl)) N_AST4(node) = (Node)0;
  1199.         N_SIDE(node) = FALSE;
  1200.         make_insert_node(node, tup_new1((char *)node2), copy_node(node));
  1201.         break;
  1202.  
  1203.     /*
  1204.      *--------------------------------
  1205.      * 9.2 Task types and task objects
  1206.      */
  1207.     case(as_task):
  1208.         /* Transform it to procedure with modified statements */
  1209.         node1 = N_AST1(node); /* id node */
  1210.         /* N_AST2(node) declarations */
  1211.         /* N_AST3(node) statements */
  1212.         /* N_AST4(node) handler */
  1213.         /* N_UNQ(node1) task name */
  1214.         /* TYPE_OF(N_UNQ(node1)) type name */
  1215.         /* get associated procedure name */
  1216.         N_UNQ(node1) = assoc_symbol_get(TYPE_OF(N_UNQ(node1)), TASK_INIT_PROC);
  1217.  
  1218.         tup = tup_new(2);
  1219.         tup[1] = (char *) N_AST2(node); /* declaration node */
  1220.         node3 = node_new(as_end_activation);
  1221.         N_VAL(node3) = (char *) 1;      /* end activation OK */
  1222.         tup[2] = (char *) node3;
  1223.         N_KIND(node) = as_subprogram_tr;
  1224.  
  1225.         N_AST1(node) = new_statements_node(tup_new1((char *) new_block_node(
  1226.           new_name_node(symbol_task_block), tup, tup_new1((char *)N_AST3(node)),
  1227.           N_AST4(node))));
  1228.         N_AST2(node) = OPT_NODE;
  1229.         N_UNQ(node) = N_UNQ(node1);
  1230.         node2 = node_new(as_terminate); /* terminate node */
  1231.         tup = tup_new(2);
  1232.         tup[1] = (char *) 0;
  1233.         tup[2] = (char *) 2;
  1234.         N_VAL(node2) = (char *) tup;
  1235.         tup = tup_new(2);
  1236.         tup[2] = (char *) node2;        /* terminate node */
  1237.         node2 = node_new(as_end_activation);
  1238.         N_VAL(node2) = (char *) 0;   /* activation failed */
  1239.         tup[1] = (char *) node2;
  1240.         N_AST4(node) = new_statements_node( tup );
  1241.         expand(node);
  1242.         break;
  1243.  
  1244.     /*
  1245.      *------------------------------------------------
  1246.      * 9.3 Task Execution - Task Activation
  1247.      */
  1248.  
  1249.     case(as_activate_spec):
  1250.         break;
  1251.  
  1252.     case(as_end_activation):
  1253.     case(as_create_task):
  1254.         N_SIDE(node) = TRUE;
  1255.         break;
  1256.  
  1257.     case(as_current_task):
  1258.         sym1 = N_UNQ(node); /* task name */
  1259.         N_SIDE(node) = FALSE;
  1260. #ifdef SHORT
  1261.         /* enable this code when and if support short integers */
  1262.         N_TYPE(node) = symbol_short_integer;
  1263.         new_symbol(sym1, na_obj, symbol_short_integer, (Tuple)0, (Symbol)0);
  1264.         make_const_node(node, sym1, symbol_short_integer, copy_node(node));
  1265. #else
  1266.         N_TYPE(node) = symbol_integer;
  1267.         new_symbol(sym1, na_obj, symbol_integer, (Tuple)0, (Symbol)0);
  1268.         make_const_node(node, sym1, symbol_integer, copy_node(node));
  1269. #endif
  1270.         break;
  1271.  
  1272.     case(as_entry_name):
  1273.         expand(N_AST1(node)); /*  task node */
  1274.         /* N_AST2(node)          entry node */
  1275.         node1 = N_AST3(node); /* index node */
  1276.         if (node1 != OPT_NODE) {
  1277.             node2 = copy_node(node1);
  1278.             /* Since N_AST3 and N_UNQ overlaid, clear N_AST3 field if 
  1279.              * currently defined.
  1280.              */
  1281.             if (N_AST3_DEFINED(N_KIND(node1)))
  1282.                 N_AST3(node1) = (Node)0;
  1283.             N_KIND(node1) = as_convert;
  1284. #ifdef SHORT
  1285.             N_AST1(node1) = new_name_node(symbol_short_integer);
  1286. #else
  1287.             N_AST1(node1) = new_name_node(symbol_integer);
  1288. #endif
  1289.             N_LIST(node1) = (Tuple)0;
  1290.             N_AST2(node1) = node2 ;
  1291. #ifdef SHORT
  1292.             N_TYPE(node1) = symbol_short_integer;
  1293. #else
  1294.             N_TYPE(node1) = symbol_integer;
  1295. #endif
  1296.             expand(node1);
  1297.         }
  1298.         break;
  1299.  
  1300.     /*
  1301.      *------------------------------------------------
  1302.      * 9.4 Task Dependance - Termination of Tasks
  1303.      */
  1304.     case(as_terminate):
  1305.         break;
  1306.  
  1307.     case(as_terminate_alt):
  1308.         break;
  1309.  
  1310.     /*
  1311.      *------------------------------------------------
  1312.      * 9.5 Entries, entry calls, and accept statements
  1313.      */
  1314.     case(as_ecall):
  1315.         expand(N_AST1(node)) ; /* object node */
  1316.         node2 = N_AST2(node) ; /* arguments list */
  1317.         FORTUP(node1 = (Node), N_LIST(node2), ft1);
  1318.             expand(node1); /* argument node */
  1319.         ENDFORTUP(ft1);
  1320.         break;
  1321.  
  1322.     case(as_conditional_entry_call):
  1323.         /* Transform into timed entry call with delay 0 */
  1324.         /* N_AST1(node) call statement node */
  1325.         /* N_AST2(node) statements node */
  1326.         /* N_AST3(node) else part */
  1327.         node1 = node_new(as_delay_alt); /* delay alternative */
  1328.         node2 = node_new(as_delay);     /* delay expression  */
  1329.         N_AST1(node2) = new_ivalue_node(
  1330.           rat_const(rat_fri(int_fri(0), int_fri(1))), symbol_duration);
  1331.         N_AST1(node1) = node2 ;
  1332.         N_AST2(node1) = N_AST3(node) ; /* else part */
  1333.         N_KIND(node) = as_timed_entry_call;
  1334.         N_AST3(node) = node1 ;
  1335.         expand(node);
  1336.         break;
  1337.  
  1338.     case(as_timed_entry_call):
  1339.         expand(N_AST1(node)) ; /* call node */
  1340.         expand(N_AST2(node)) ; /* stmt node */
  1341.         node1 = N_AST3(node) ; /* delay alternative */
  1342.         expand(N_AST1(node1)); /* delay expression  */
  1343.         expand(N_AST2(node1)); /* else part */
  1344.         break;
  1345.  
  1346.     case(as_accept):
  1347.         /* Replace [id_node, index_node] by an entry_name node */
  1348.         node1 = node_new(as_entry_name); /* entry name */
  1349.         N_AST1(node1) = OPT_NODE ;
  1350.         N_AST2(node1) = N_AST1(node); /* id node */
  1351.         N_AST3(node1) = N_AST2(node); /* index node */
  1352.         N_AST1(node) = node1 ;        /* entry name */
  1353.         N_AST2(node) = N_AST3(node);
  1354.         N_AST3(node) = node2 = N_AST4(node);
  1355.         N_AST4(node) = (Node) 0;
  1356.         expand(node1);
  1357.  
  1358.         if (node2 != OPT_NODE) {      /* body node */
  1359.             node1 = new_block_node(OPT_NODE, tup_new(0), 
  1360.               tup_new1((char *)node2), node_new(as_exception_accept));
  1361.             expand(node1);
  1362.             N_AST3(node) = node1 ;
  1363.         }
  1364.         break;
  1365.  
  1366.     case(as_accept_alt):
  1367.         expand(N_AST1(node)); /* accept statement node */
  1368.         expand(N_AST2(node)); /* statements node */
  1369.         break;
  1370.  
  1371.     /*
  1372.      *----------------------------------------
  1373.      * 9.6 Delay statements, duration and time
  1374.      */
  1375.     case(as_delay):
  1376.         expand(N_AST1(node)); /* expression */
  1377.         break;
  1378.  
  1379.     /*
  1380.      *----------------------
  1381.      * 9.7 Select statements
  1382.      */
  1383.  
  1384.     case(as_selective_wait):
  1385.         node1 = N_AST1(node); /* list of alternatives */
  1386.         FORTUP(node2 = (Node), N_LIST(node1), ft1);
  1387.             expand(node2);      /* alternative */
  1388.         ENDFORTUP(ft1);
  1389.         node2 = N_AST2(node); /* else part */
  1390.         if (node2 != OPT_NODE) {
  1391.             expand(node2); /* else part */
  1392.             node3 = node_new(as_delay_alt) ; /* delay alternative */
  1393.             N_AST2(node3) = node2 ;          /* else part */
  1394.             node2 = node_new(as_delay);
  1395.             N_AST1(node2) = new_ivalue_node(
  1396.               rat_const(rat_fri(int_fri(0), int_fri(1))), symbol_duration);
  1397.             N_AST1(node3) = node2 ;          /* delay expression */
  1398.             N_LIST(node1) = tup_with(N_LIST(node1), (char *) node3);
  1399.         }
  1400.         break;
  1401.  
  1402.     case(as_guard):
  1403.         expand(N_AST1(node)); /* condition node */
  1404.         expand(N_AST2(node)); /* alternative node */
  1405.         break;
  1406.  
  1407.     case(as_delay_alt):
  1408.         expand(N_AST1(node)); /* expression */
  1409.         expand(N_AST2(node)); /* statements */
  1410.         break;
  1411.  
  1412.     /*
  1413.      *---------------------
  1414.      * 9.9 Abort statements
  1415.      */
  1416.  
  1417.     case(as_abort):
  1418.         FORTUP(node1 = (Node), N_LIST(node), ft1);
  1419.             expand(node1); /* id of the task to be aborted */
  1420.         ENDFORTUP(ft1);
  1421.         break;
  1422.  
  1423.     /*
  1424.      * Chapter 10. Program structure and compilation issues
  1425.      *---------------------------------------
  1426.      * 10.1 Compilation units - Library units
  1427.      */
  1428.  
  1429.     case(as_unit):
  1430.         expand(N_AST2(node)); /* unit root node */
  1431.         break;
  1432.  
  1433.     /*
  1434.      *------------------------------------
  1435.      * 10.2 Subunits of compilations units
  1436.      */
  1437.     case(as_subprogram_stub_tr):
  1438.     case(as_package_stub):
  1439.     case(as_task_stub):
  1440.         lib_stub_put(N_VAL(node), AISFILENAME); /* N_VAL(node) is stub_name */
  1441.         stub_parent_put(N_VAL(node), unit_name);
  1442.         /* generate a slot for a fake proper body which is considered obsolete.
  1443.          * This is due to handling of generic stubs.
  1444.          */
  1445.         pUnits[unit_number(N_VAL(node))]->libInfo.obsolete = string_ds;/*"$D$"*/
  1446.         N_SIDE(node) = FALSE;
  1447.         break;
  1448.  
  1449.     case(as_separate):
  1450.         expand(N_AST2(node)); /* unit root node */
  1451.         break;
  1452.  
  1453.     /*
  1454.      * Chapter 11. Exceptions
  1455.      */
  1456.     /*
  1457.      *------------------------
  1458.      * 11.2 Exception handlers
  1459.      */
  1460.  
  1461.     case(as_handler):
  1462.         /* Transform the handler into a "elsif test_exception or
  1463.          * test_exception ... then statements".
  1464.          * when others is expanded as an "elsif TRUE then statements"
  1465.          * Do not expand statements, as they will be expanded when the if
  1466.          * statement is.
  1467.          */
  1468.         node1 = N_AST1(node) ; /* list of exceptions */
  1469.         tup  = N_LIST(node1) ; /* list of exception nodes */
  1470.         node1 = (Node) tup[1]; /* name of first exception */
  1471.         if (N_KIND(node1) == as_others)
  1472.             node2 = new_ivalue_node(int_const(TRUE), symbol_boolean);
  1473.         else {
  1474.             node2 = node_new(as_test_exception);     /* root of if */
  1475.             N_AST1(node2) = node1;      /* name of first exception */
  1476.             N_TYPE(node2) = symbol_boolean;
  1477.             for (nk = 2; nk <= tup_size(tup); nk++) {
  1478.                 node1 = node_new(as_test_exception); /* running condition */
  1479.                 N_AST1(node1) = (Node) tup[nk];      /* name of exception */
  1480.                 N_TYPE(node1) = symbol_boolean;
  1481.                 node2 = new_binop_node(symbol_or, node2, node1, symbol_boolean);
  1482.             }
  1483.         }
  1484.  
  1485.         node1 = N_AST2(node) ; /* statements */
  1486.         node3 = N_AST1(node1); /* list of statements */
  1487.         /* N_AST3(node) terminal statements node */
  1488.         N_LIST(node3) = tup_with(N_LIST(node3), (char *) N_AST3(node));
  1489.  
  1490.         N_KIND(node) = as_cond_statements;
  1491.         N_AST1(node) = node2 ; /* if list */
  1492.         N_AST3(node) = N_AST4(node) = (Node) 0;
  1493.         break;
  1494.  
  1495.     case(as_exception):
  1496.         /* Transform the handler into an if statement.
  1497.          * Add an else part to that if: else raise.
  1498.          * Note: if the user has provided a "when others" clause, this will
  1499.          *       be expanded as an "elsif TRUE" branch, and optimization of
  1500.          *       the if statement will remove the (now superfluous) else.
  1501.          */
  1502.         node1 = N_AST1(node); /* terminal statement */
  1503.         FORTUP(node2 = (Node), N_LIST(node), ft1);
  1504.             N_AST3(node2) = copy_tree(node1);
  1505.             expand(node2); /* handler node */
  1506.         ENDFORTUP(ft1);
  1507.  
  1508.         tup = N_LIST(node);
  1509.         make_if_node(node, tup, new_raise_node(OPT_NAME));
  1510.         expand(node);   /* other transformations possible in this new form */
  1511.         break;
  1512.  
  1513.     /*
  1514.      *-------------------------------------------------
  1515.      * 11.5 Exceptions raised during task communication
  1516.      */
  1517.  
  1518.     case(as_exception_accept):
  1519.         break;
  1520.  
  1521.     /*
  1522.      * Chapter 12. Generics units
  1523.      */
  1524.     case(as_generic_package):
  1525.       /*
  1526.        * Added here to traverse decls list to catch presence of stubs.
  1527.        * This is necessary to allocate a unit number for it to enable
  1528.        *  subsequent unit numbers to be correct.
  1529.        */
  1530. #ifdef TBSL
  1531.        expand(N_AST2(node));
  1532. #endif
  1533.        N_SIDE(node) = FALSE;
  1534.        break;
  1535.     /*
  1536.      *---------------------------
  1537.      * 12.3 Generic instanciation
  1538.      */
  1539.     case(as_package_instance):
  1540.         /* This  node  indicates  a late  instantiation, i.e.  a  package
  1541.          * instantiation  that  precedes  the  compilation of the generic
  1542.          * package body. If the package has been seen, the instantiation is
  1543.          * now completed. If none is needed, an empty package is created.
  1544.          * Otherwise the missing body is treated as a stub.
  1545.          */
  1546.         sym1 = N_UNQ(N_AST1(node)) ; /* package name */
  1547.         sym2 = N_UNQ(N_AST2(node)) ; /* generic name */
  1548.         retrieve_generic_body(sym2);
  1549.         tup = (Tuple) N_VAL(N_AST4(node));
  1550.         instance_map = (Symbolmap) tup[1];
  1551.         cboolean = (int) tup[2];
  1552.         tup = SIGNATURE(sym2);
  1553.         /* (Node) tup[2] declarations */
  1554.         /* (Node) tup[3] private part */
  1555.         node1 = (Node) tup[4];       /* body node */
  1556.         tup2 = (Tuple) tup[5];        /* must_constrain generic types */
  1557.  
  1558.         /* check to see if this is a case where the body is a stub. */
  1559.         if (node1 == OPT_NODE) {
  1560.             char     *stub_nam;
  1561.             tup = stubs(unit_name);
  1562.             FORTUP(stub_nam = (char *), tup, ft1);
  1563.                 if (streq(unit_name_name(stub_nam), ORIG_NAME(sym2))) {
  1564.                     if (!read_ais(AISFILENAME, TRUE, stub_nam, 0, TRUE)) break;
  1565.                     tup  = SIGNATURE(sym2);
  1566.                     node1 = (Node) tup[4];     /* body node */
  1567.                     tup2 = (Tuple) tup[5];     /* must_constrain generic types*/
  1568.                     break;
  1569.                 }
  1570.             ENDFORTUP(ft1);
  1571.         }
  1572.         /*$TBSL retrieve_old_tree(node1); */
  1573.         retrieve_generic_tree(node1, (Node)0);
  1574.         if (node1 != OPT_NODE) {       /* Instantiate body. */
  1575.             /* Instantiate all entities local to  the package body.
  1576.              * Instance_map marks the entities defined in the spec, 
  1577.              * and already instantiated.
  1578.              */
  1579.             tup = instantiate_symbtab(sym2, sym1, instance_map);
  1580.             instance_map = (Symbolmap) tup[1];
  1581.             /* instantiate the AST itself, and complete the 
  1582.              * instantiation of the symbol table.
  1583.              */
  1584.             node_map = nodemap_new() ;        /* global object. */
  1585.  
  1586.             node2 = instantiate_tree(node1, instance_map) ; /* new body */
  1587.             N_KIND(node2) = as_package_body ;
  1588.             copy_attributes(node2, node);
  1589.             /* Node references in the symbol table 
  1590.              * must point to the instantiated tree.
  1591.              */
  1592.             tup1 = (Tuple) tup[3];
  1593.             update_symbtab_nodes(instance_map, tup1) ;
  1594.             tup1 = (Tuple) tup[2];
  1595.             check_priv_instance(tup2, instance_map) ;
  1596.             /* The full declarations of private entities must be updated as
  1597.              * well, for the generic package and all inner packages.
  1598.              */
  1599.             /*  loop for sym3 in tup1 do
  1600.              *      private_decls(instance_map(sym3)) =
  1601.              *         update_private_decls(sym3, instance_map) ;
  1602.              *  end loop ;
  1603.              */
  1604.             FORTUP(sym3 = (Symbol), tup1, ft1);
  1605.                 sym4 = symbolmap_get(instance_map, sym3);
  1606.                 private_decls(sym4) =
  1607.                   (Set)update_private_decls(sym3, instance_map);
  1608.             ENDFORTUP(ft1);
  1609.             N_KIND(node) = as_package_body ;
  1610.             mint(node);
  1611.             expand(node) ;
  1612.         }
  1613.         else if ( ! cboolean) {
  1614.             /* assume that none will be seen, and build empty package body.*/
  1615.             N_KIND(node) = as_package_body ;
  1616.             N_AST1(node) = new_name_node(sym1) ;
  1617.             N_AST2(node) = OPT_NODE;
  1618.             N_AST3(node) = OPT_NODE;
  1619.             N_AST4(node) = OPT_NODE;
  1620.             expand(node) ;
  1621.         }
  1622.         else
  1623.             user_error("Separately compiled generics not supported ") ;
  1624.         break;
  1625.  
  1626.     case(as_function_instance):
  1627.     case(as_procedure_instance):
  1628.         /* Same as previous one, for subrograms. Here the body is always
  1629.          * needed.
  1630.          */
  1631.         /* Unpack instantiation information, attached to N_VAL of node. */
  1632.         tup = (Tuple)N_VAL(N_AST4(node));
  1633.         type_map = (Symbolmap)tup[1];
  1634.         sym1 = N_UNQ(N_AST2(node)) ; /* generic name */
  1635.         retrieve_generic_body(sym1);
  1636.         tup  = SIGNATURE(sym1);
  1637.         node1 = (Node) tup[3];       /* body node */
  1638.         tup1 = (Tuple) tup[4];       /* must_constrain */
  1639.  
  1640.         /* check to see if this is a case where the body is a stub. */
  1641.         if (node1 == OPT_NODE) {
  1642.             char     *stub_nam;
  1643.             tup = stubs(unit_name);
  1644.             FORTUP(stub_nam = (char *), tup, ft1);
  1645.                 if (streq(unit_name_name(stub_nam), ORIG_NAME(sym1))) {
  1646.                     if (!read_ais(AISFILENAME, TRUE, stub_nam, 0, TRUE)) break;
  1647.                     tup = SIGNATURE(sym1);
  1648.                     node1 = (Node) tup[3];       /* body node */
  1649.                     tup1 = (Tuple) tup[4];         /* must_constrain */
  1650.                     break;
  1651.                 }
  1652.             ENDFORTUP(ft1);
  1653.         }
  1654.  
  1655.         if (node1 != OPT_NODE) {
  1656.             /*$TBSL retrieve_old_tree(node1); */
  1657.             retrieve_generic_tree(node1, (Node)0);
  1658.             instantiation_code = N_LIST(N_AST3(node)) ;
  1659.             instantiate_subprog_tree(node, type_map) ;
  1660.             /* Take the subprogram created by the instantiation and reformat
  1661.              * the spec node to be of a form as_procedure_tr (as_function_tr) 
  1662.              * with the formal part detached from the tree. Move up the id_node
  1663.              * (subprogram name) info to the specfication node.
  1664.              */
  1665.             node2 = N_AST1(node);
  1666.             node3 = N_AST1(node2);
  1667.             N_KIND(node) = as_subprogram_tr;
  1668.             N_AST1(node) = N_AST3(node);
  1669.             N_UNQ(node) = N_UNQ(node3);
  1670.             /* add instantiation code to declarative part of subprogram.
  1671.                * this is not strictly correct, as bounds checks should be
  1672.                * elaborated outside of the subprogram body. To be cleaned up
  1673.                * later.
  1674.                */
  1675.             ntup = tup_add(instantiation_code, N_LIST(N_AST2(node))) ;
  1676.             tup_free(instantiation_code) ;
  1677.             N_LIST(N_AST2(node)) = ntup ;
  1678.  
  1679.             check_priv_instance(tup1, instance_map) ;
  1680.             mint(node);
  1681.             expand(node) ;
  1682.         }
  1683.         else
  1684.             user_error("Separately compiled generics not supported ") ;
  1685.         break;
  1686.  
  1687.     case(as_check_bounds):
  1688.         sym1 = N_UNQ(N_AST1(node)) ; /* generic type */
  1689.         sym2 = N_UNQ(N_AST2(node)) ; /* actual type */
  1690.         if (is_discrete_type (sym2)) {
  1691.             node1 = new_attribute_node(ATTR_T_FIRST, new_name_node(sym1),
  1692.               OPT_NODE, sym1);
  1693.             node2 = new_attribute_node(ATTR_T_LAST, new_name_node(sym1),
  1694.               OPT_NODE, sym1);
  1695.             node3 = new_attribute_node(ATTR_T_FIRST, new_name_node(sym2),
  1696.               OPT_NODE, sym2);
  1697.             node4 = new_attribute_node(ATTR_T_LAST, new_name_node(sym2),
  1698.               OPT_NODE, sym2);
  1699.             /*$ TBSL: some constant folding. */
  1700.             make_if_node(node,
  1701.               tup_new1((char *) new_cond_stmts_node(
  1702.               new_binop_node(symbol_or,
  1703.               new_binop_node(symbol_ne,
  1704.               node1,
  1705.               node3,
  1706.               symbol_boolean),
  1707.               new_binop_node(symbol_ne,
  1708.               node2,
  1709.               node4,
  1710.               symbol_boolean),
  1711.               symbol_boolean),
  1712.               new_raise_node(symbol_constraint_error)  )
  1713.               ),
  1714.               OPT_NODE);
  1715.         }
  1716.         else if (is_fixed_type (sym2)) {
  1717.  
  1718.             /* conversion of fixed is possible if they have the same accuracy */
  1719.             if (rat_neq ( RATV (get_ivalue
  1720.               (((Node) numeric_constraint_delta (get_constraint(sym1))))),
  1721.               RATV (get_ivalue
  1722.               (((Node) numeric_constraint_delta (get_constraint(sym2))))))) {
  1723.                 make_raise_node(node, symbol_constraint_error);
  1724.                 USER_WARNING(
  1725.     "Due to difference in fixed point accuracy, conversion of array will raise",
  1726.                   " CONSTRAINT_ERROR"); 
  1727.             }
  1728.         }
  1729.         else if (is_float_type (sym2)) {
  1730.  
  1731.             /* conversion of float is possible if they have the same floating
  1732.              * point accuracy
  1733.              */
  1734.             if ( INTV (get_ivalue (((Node) numeric_constraint_delta
  1735.               (get_constraint(sym1))))) != INTV (get_ivalue
  1736.               (((Node) numeric_constraint_delta (get_constraint(sym2)))))) {
  1737.                 make_raise_node(node, symbol_constraint_error);
  1738.                 USER_WARNING(
  1739. "Due to difference in floating point accuracy, conversion of array will raise",
  1740.                   " CONSTRAINT_ERROR"); 
  1741.             }
  1742.         }
  1743.         expand(node);
  1744.         N_SIDE(node) = FALSE;
  1745.         break;
  1746.  
  1747.     case(as_check_discr):
  1748.         node1 = N_AST1(node) ;
  1749.         sym1  = N_UNQ(N_AST2(node)) ; /* type name */
  1750.         sym2  = N_UNQ(N_AST3(node)) ; /* dscriminant name */
  1751.         make_if_node(node,
  1752.           tup_new1((char *) new_cond_stmts_node(
  1753.           new_binop_node(symbol_ne,
  1754.           node1,
  1755.           new_discr_ref_node(sym2, sym1),
  1756.           symbol_boolean),
  1757.           new_raise_node(symbol_constraint_error)  )
  1758.           ),
  1759.           OPT_NODE);
  1760.         expand(node);
  1761.         N_SIDE(node) = FALSE;
  1762.         break;
  1763.  
  1764.     case(as_expanded):
  1765.         /* This node removed, WITHOUT expanding its descendant! */
  1766.         node1 = N_AST1(node); /* son node */
  1767.         copy_attributes(node1, node);
  1768.         break;
  1769.  
  1770.     /*
  1771.      * Chapter 13. Representation clauses
  1772.      *--------------------
  1773.      * 13.2 Length clauses
  1774.      */
  1775.  
  1776.     case(as_length_clause):
  1777.     case(as_enum_rep_clause):
  1778.     case(as_rec_rep_clause):
  1779.         delete_node(node);
  1780.         N_SIDE(node) = FALSE;
  1781.         break;
  1782.  
  1783.     case(as_opt):
  1784.         break;
  1785.  
  1786.     case(as_pragma):
  1787.     case(as_arg):
  1788.     case(as_enum):
  1789.     case(as_num_decl):
  1790.     case(as_int_type):
  1791.     case(as_float_type):
  1792.     case(as_fixed_type):
  1793.     case(as_array_type):
  1794.     case(as_record):
  1795.     case(as_discr_ref):
  1796.     case(as_simple_name):
  1797.     case(as_labels):
  1798.     case(as_ivalue):
  1799.     case(as_null):
  1800.     case(as_subprogram_decl_tr):
  1801.     case(as_private_decl):
  1802.     case(as_rename_ex):
  1803.     case(as_rename_pack):
  1804.     case(as_entry):
  1805.     case(as_entry_family):
  1806.     case(as_except_decl):
  1807.     case(as_raise):
  1808.     case(as_test_exception):
  1809.     case(as_generic_function):
  1810.     case(as_generic_procedure):
  1811.     case(as_generic_formals):
  1812.         N_SIDE(node) = FALSE;
  1813.         break;
  1814.  
  1815.     default:
  1816.         compiler_error_k( "Illegal kind of node in expand: ", node);
  1817.     }
  1818. }
  1819.